On error resume next
Set objFSO = CreateObject("Scripting.FileSystemObject")
set shApp = CreateObject("Shell.Application")

shApp.MinimizeAll
wscript.sleep 200


Dim objExplorer
ShowIE
Const ForWriting = 2

set wscSh = CreateObject("WScript.Shell")

Set myCompFolder = shApp.Namespace(&H11&)
Set myCompFolderItem = myCompFolder.Self

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

strComputerName = GetComputerName

strRootPath = objFSO.GetAbsolutePathName(".")
	strPath = strRootPath + "\" + strComputerName +"_"+GetIPAddress+"_"+getTimestamp
	strBinFilename = strPath + "\" + strComputerName + "_"+GetIPAddress+"_"+getTimestamp+".bin"
	

	If objFSO.FolderExists(strPath) Then
		objFSO.DeleteFolder(strPath)
	end if
	
	objFSO.CreateFolder(strPath)
	

	Set objTextFile = objFSO.CreateTextFile(strBinFilename, TRUE)



	ComputerInfo

	objTextFile.WriteLine vbcrlf & vbcrlf & "Installed Programs" & vbcrlf
	objTextFile.WriteLine "Name" & vbtab & "Description" & vbtab & "Install Location" & vbtab & "Install State" & vbtab & "Vendor" & vbtab & "Version" & vbtab & "Install Date"

	'InstalledPrograms
	Dim InstallLine
	InstallLine=objTextFile.Line
	if InstallLine<=12 then
		ReadFromRegistry
	end if

	UninstalledPrograms_Events



	objTextFile.Close

	set shApp = Nothing
	Set WshShell=Nothing
	Set objWMIService = Nothing
CloseIE
Wscript.Echo "Done!"


WScript.Quit



Sub CloseIE()
	objExplorer.Visible=0
	objExplorer.Close

End Sub

Sub ShowIE()
	Set objExplorer = wscript.CreateObject("InternetExplorer.Application","IE_")
	objExplorer.Navigate "about:blank"
	objExplorer.ToolBar = 0
	objExplorer.StatusBar = 0
	objExplorer.Width = 400
	objExplorer.Height = 200
	objExplorer.Left = 0
	objExplorer.Top = 0
	objExplorer.Visible = 1

	Set objDocument = objExplorer.Document
	objDocument.Open

	objDocument.Writeln "<html><head><title>SAM Review</title>"
	objDocument.Writeln "<body bgcolor=#8181F7><MARQUEE><Font color=#0B610B size=5> <B> Review is in progress. Please Wait Till Done.....................!! </b> </font></MARQUEE> </body>"

	objDocument.Writeln "</html>"
	objDocument.close


End Sub




Function GetIPAddress
dim strAddresses, strIPAddress, strWQL
strWQL = "SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = 'True'"
Set colIPResults = objWMIService.ExecQuery(strWQL)
For Each objNIC In colIPResults
For Each strIPAddress in objNIC.IPAddress
If strAddresses = "" Then
	strAddresses = strIPAddress
Else
	strAddresses = strAddresses
End If
Next
Next
GetIPAddress=strAddresses
End Function



Sub ReadFromRegistry()


Dim strComputer, strKey, strSubKey
Dim objRegistry
Dim arrSubKeys()
Dim strDisplayName, strDisplayVersion, strInstallLocation, strPublisher, strInstallDate


Set objRegistry = GetObject("winmgmts:"   & _
    "{impersonationLevel=Impersonate}!\\" & _
    GetComputerName & "\root\default:StdRegProv")

Const HKEY_LOCAL_MACHINE = &H80000002

strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"

objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys


For Each strSubKey In arrSubKeys

    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
                               strKey & "\" & strSubKey, _
                               "DisplayName", _
                               strDisplayName

    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
                               strKey & "\" & strSubKey, _
                               "DisplayVersion", _
                               strDisplayVersion

    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
                               strKey & "\" & strSubKey, _
                               "InstallLocation", _
                               strInstallLocation

    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
                               strKey & "\" & strSubKey, _
                               "Publisher", _
                               strPublisher

    objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
                               strKey & "\" & strSubKey, _
                               "InstallDate", _
                               strInstallDate

	dim sTmp 
	sTmp=""
	if not isNull(strDisplayName) then
	if instr(strDisplayName,"SQL")<>0 and strInstallLocation<>"" then
		dim logpath, logfile,i, strEdition 
		set logpath= objFSO.GetFolder(strInstallLocation & "\LOG")
		for each file in logpath.Files
			set logfile = objFSO.OpenTextFile(strInstallLocation & "\LOG\" & file.name, 1)			
			for i=1 to 4 
				strEdition=logfile.readLine
				strEdition=Replace(strEdition,vbtab,"")
			next						
			strDisplayName= strDisplayName & " " & strEdition
			Exit for
		next		

	end if
	if instr(strDisplayName,"SQL")<>0 and strInstallLocation="" then
		Wscript.Echo "Please Take screenshot for SQL"
	end if

	if InStr(strDisplayName,"Microsoft")<>0 OR InStr(strPublisher,"Microsoft") OR InStr(strSubKey,"Microsoft")<>0 then
		sTmp = sTmp & strSubKey & vbtab & _
			 strDisplayName & vbtab & _
			 strInstallLocation & vbtab & _
			 "0" & vbtab & _
			 strPublisher & vbtab & _
		     strDisplayVersion & vbtab & _
		     strInstallDate	

  	end if
	end if    
	strDisplayName = vbEmpty
    	strDisplayVersion = vbEmpty
	strInstallLocation = vbEmpty
	strPublisher=vbEmpty
	strInstalldate=vbEmpty	
	if sTmp<>"" then
		objTextFile.WriteLine sTmp
	end if
Next




End sub


Function GetComputerName
	Set colOSes = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
	For Each objOS in colOSes
		GetComputerName = objOS.CSName
	Next
End Function



function getTimestamp
 vNow = Now()
 vMthStr = CStr(Month(vNow))
 vDayStr = CStr(Day(vNow))
 vHourStr = CStr(Hour(vNow))
 vMinuteStr = CStr(Minute(vNow))
 ' Add leading zeroes to month, day, hour, minutes
 If Len(vMthStr) = 1 Then
    vMthStr = "0" & vMthStr
 End If
 If Len(vDayStr) = 1 Then
    vDayStr = "0" & vDayStr
 End If
 If Len(vHourStr) = 1 Then
    vHourStr = "0" & vHourStr
 End If
 If Len(vMinuteStr) = 1 Then
    vMinuteStr = "0" & vMinuteStr
 End If
 ' Get date string in yyyymmddhhnn format.
getTimestamp = Year(vNow) & vMthStr & vDayStr & vHourStr & vMinuteStr
End function




Sub ComputerInfo()
'Computer Information
Set colOSes = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

For Each objOS in colOSes
    objTextFile.WriteLine "Computer Name:" & vbtab & objOS.CSName
	objTextFile.WriteLine "   Serial No.:" & vbtab & objOS.SerialNumber 
	objTextFile.WriteLine "      Caption:" & vbtab & objOS.Caption
    objTextFile.WriteLine "      Version:" & vbtab & objOS.Version
    objTextFile.WriteLine "    Build No.:" & vbtab & objOS.BuildNumber
    objTextFile.WriteLine " Service Pack:" & vbtab & objOS.ServicePackMajorVersion & "." & objOS.ServicePackMinorVersion 
	'objTextFile.WriteLine "   Product ID:" & vbtab & GetWindowsProductID
	'objTextFile.WriteLine "  Product Key:" & vbtab & GetWindowsProductKey
Next
End Sub

Sub InstalledPrograms()
	'Installed Programs
	Set colSoftware = objWMIService.ExecQuery("SELECT * FROM Win32_Product")
	
	sTmp = ""
	For Each objSoftware in colSoftware
	pos=InStr(objSoftware.Vendor,"Microsoft")
	'Add for search ms in product.name
	pos1=InStr(objSoftware.Description,"Microsoft")
	if pos<>0 OR pos1<>0 then
		strDisplayName=objSoftware.Name
		if instr(strDisplayName,"SQL")<>0 and objSoftware.InstallLocation<>"" then
			dim logpath, logfile,i, strEdition 
			set logpath= objFSO.GetFolder(strInstallLocation & "\LOG")
			for each file in logpath.Files
				set logfile = objFSO.OpenTextFile(strInstallLocation & "\LOG\" & file.name, 1)			
				for i=1 to 4 
					strEdition=logfile.readLine
					strEdition=Replace(strEdition,vbtab,"")
				next						
				strDisplayName= strDisplayName & " " & strEdition
				Exit for
			next		

		end if

		sTmp = sTmp & strDisplayName & vbtab & _
		 objSoftware.Description & vbtab & _
		 objSoftware.InstallLocation & vbtab & _
		 objSoftware.InstallState & vbtab & _
		 objSoftware.Vendor & vbtab & _
		 objSoftware.Version & vbtab & _
		 objSoftware.InstallDate & vbcrlf
	end if
	Next


	sTmp = BubbleSort(sTmp)

	objTextFile.WriteLine sTmp
End Sub


Sub UninstalledPrograms_Events()
	'Uninstalled Programs
	objTextFile.WriteLine vbcrlf & vbcrlf & "Uninstalled Programs" & vbcrlf

	Set colEvents = objWMIService.ExecQuery("Select * from Win32_NTLogEvent Where LogFile='Application' And EventCode='11724'")
	sTmp = ""
	For Each objEvent in colEvents
	pos=InStr(objEvent.Message,"Microsoft")
	pos1=InStr(objEvent.Message,"Removal")
	
	'if pos1<>0 then
	if pos<>0 and pos1<>0 then
		strTimeWritten = objEvent.TimeWritten
		
		dtmTimeWritten = CDate(Mid(strTimeWritten, 5, 2) & "/" & _
			Mid(strTimeWritten, 7, 2) & "/" & Left(strTimeWritten, 4) _
				& " " & Mid (strTimeWritten, 9, 2) & ":" & _
					Mid(strTimeWritten, 11, 2) & ":" & Mid(strTimeWritten, 13, 2))

		dtmDate = FormatDateTime(dtmTimeWritten, vbShortDate)
		dtmTime = FormatDateTime(dtmTimeWritten, vbLongTime)

		strEvent = dtmDate & vbTab & dtmTime & vbTab

		strDescription = objEvent.Message
		If IsNull(strDescription) Then
			strDescription = "The event description cannot be found."
		Else 
			strDescription = Replace(strDescription, vbCrLf, " ")
		End If
		strEvent = strEvent & strDescription

		sTmp = sTmp & strEvent & vbcrlf
	end if
	Next

	sTmp = BubbleSort(sTmp)

	objTextFile.WriteLine sTmp
End Sub

Function BubbleSort(sTmp)
  'cheapo bubble sort
  Dim aTmp, i, j, temp
  aTmp = Split(sTmp, vbcrlf)  
  For i = UBound(aTmp) - 1 To 0 Step -1
    For j = 0 to i - 1
      If LCase(aTmp(j)) > LCase(aTmp(j+1)) Then
        temp = aTmp(j + 1)
        aTmp(j + 1) = aTmp(j)
        aTmp(j) = temp
      End if
    Next
  Next
  BubbleSort = Join(aTmp, vbcrlf)
End Function
